home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / DATADICT / DBLOOK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-21  |  11.7 KB  |  386 lines
  1. unit Dblook;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   StdCtrls, Forms, DBCtrls, DB, DBTables, Mask, ExtCtrls, Dialogs,
  8.   clipbrd, scaler;
  9.  
  10. type
  11.  
  12.   TDDedit = class(TForm)
  13.     ScrollBox: TScrollBox;
  14.     Label1: TLabel;
  15.     EditFIELD_NAME: TDBEdit;
  16.     Label3: TLabel;
  17.     EditFIELD_LEN: TDBEdit;
  18.     Label4: TLabel;
  19.     EditFIELD_DEC: TDBEdit;
  20.     Label6: TLabel;
  21.     MemoIDX_EXPRES: TDBMemo;
  22.     Label7: TLabel;
  23.     EditTAB_ORDER: TDBEdit;
  24.     Label8: TLabel;
  25.     EditTABLE_NAME: TDBEdit;
  26.     CheckBoxREQUIRED: TDBCheckBox;
  27.     Label10: TLabel;
  28.     EditDEFAULT: TDBEdit;
  29.     MemoDEFINE: TDBMemo;
  30.     Label12: TLabel;
  31.     MemoVALIDVALUE: TDBMemo;
  32.     Label13: TLabel;
  33.     MemoNOTES: TDBMemo;
  34.     Label14: TLabel;
  35.     EditHINT: TDBEdit;
  36.     Label15: TLabel;
  37.     EditSCR_PROMPT: TDBEdit;
  38.     Label16: TLabel;
  39.     MemoHELP: TDBMemo;
  40.     CheckBoxHASLINK: TDBCheckBox;
  41.     Label18: TLabel;
  42.     EditSRCLINKTBL: TDBEdit;
  43.     Label19: TLabel;
  44.     EditSRCLINKFLD: TDBEdit;
  45.     CheckBoxIS_CALC: TDBCheckBox;
  46.     Label21: TLabel;
  47.     MemoFORMULA: TDBMemo;
  48.     DBNavigator: TDBNavigator;
  49.     Panel1: TPanel;
  50.     Panel2: TPanel;
  51.     Label9: TLabel;
  52.     CheckBoxMDX: TDBCheckBox;
  53.     LEditMask: TLabel;
  54.     EditEDITMASK: TDBEdit;
  55.     DBRadioGroup1: TDBRadioGroup;
  56.     Label2: TLabel;
  57.     DataSource1: TDataSource;
  58.     FontDialog1: TFontDialog;
  59.     FontButton: TButton;
  60.     CheckBox1: TCheckBox;
  61.     B_resize: TButton;
  62.     Label5: TLabel;
  63.     Label11: TLabel;
  64.     procedure FormCreate(Sender: TObject);
  65.     procedure FormActivate(Sender: TObject);
  66.     procedure Table1FIELD_TYPEValidate(Sender: TField);
  67.     procedure Table1FIELD_DECValidate(Sender: TField);
  68.     procedure Table1FIELD_LENValidate(Sender: TField);
  69.     procedure EditFIELD_LENEnter(Sender: TObject);
  70.     procedure EnterEditFiel(Sender: TObject);
  71.     procedure ExitEditField(Sender: TObject);
  72.     procedure EditFIELD_DECEnter(Sender: TObject);
  73.     procedure Table1AfterOpen(DataSet: TDataset);
  74.     procedure EditTABLE_NAMEExit(Sender: TObject);
  75.     procedure FontButtonClick(Sender: TObject);
  76.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  77.       Shift: TShiftState);
  78.     procedure CheckBox1Click(Sender: TObject);
  79.     procedure B_resizeClick(Sender: TObject);
  80.     procedure MemoIDX_EXPRESExit(Sender: TObject);
  81.     procedure MemoIDX_EXPRESEnter(Sender: TObject);
  82.     procedure MemoDEFINEClick(Sender: TObject);
  83.     procedure DBNavigatorClick(Sender: TObject; Button: TNavigateBtn);
  84.   private
  85.     fformfiddle : boolean;  {resized memo has shifted form}
  86.     foldtop,
  87.     foldheight : integer;  { for resizing memo fields}
  88.     { private declarations }
  89.   public
  90.     { public declarations }
  91.     Cur_data_type : integer;  {itemindex from DBRADIOGROUP}
  92.   end;
  93.  
  94. var
  95.   DDedit: TDDedit;
  96.  
  97. implementation
  98.   uses mainmenu, utils, editmemo;
  99.  
  100.   const
  101.     validDataTypes : set of char = ['C','L','N','M','D'];
  102.  
  103.  
  104. procedure TDDedit.FormCreate(Sender: TObject);
  105. begin
  106.   with DBRadioGroup1.items do begin
  107.     clear;
  108.     add('C : Character field');
  109.     add('N : Numeric field');
  110.     add('L : Boolean field');
  111.     add('D : Date field');
  112.     add('M : Memo field');
  113.     end;
  114.   with DBRadioGroup1.values do begin
  115.     clear;
  116.     add('C');
  117.     add('N');
  118.     add('L');
  119.     add('D');
  120.     add('M');
  121.     end;
  122.   ScaleForm(sender);
  123. end;
  124.  
  125. procedure TDDedit.FormActivate(Sender: TObject);
  126. var
  127.  Tlen,Tdec,ttab : TsmallintField;
  128.  Tfldname : TStringField;
  129. begin
  130.   DDedit.caption := 'Editing '+main.ddListBox.items[0];
  131.   main.sourcedatabase.close;
  132.   main.SourceDatabase.Params.clear;
  133.   main.SourceDatabase.Params.Add('PATH='+main.DDPathName);
  134.   main.SourceDatabase.open;
  135.   DataSource1.DataSet:= main.dicttable;
  136.   {Tlen := TsmallIntField.Create(main.dicttable);
  137.   Tlen.FieldName := 'FIELD_LEN';
  138.   Tlen.Name := Main.DictTABLE.Name + Tlen.FieldName;
  139.   Tlen.Index := Main.dictTable.FieldCount;
  140.   Tlen.DataSet := Main.DictTable;
  141.      {Tlen creates itself fine, but when we get to ..Active := true,
  142.        we get "Field FIELD_NAME can't be found."
  143.        So when we add field_name, we get
  144.       the data is not of the expected type!}
  145.  
  146.   {Tfldname := TstringField.Create(Self);
  147.   Tfldname.FieldName := 'FIELD_NAME';
  148.   Tfldname.Name := Main.DictTABLE.Name + Tfldname.FieldName;
  149.   Tfldname.Index := Main.dictTable.FieldCount;
  150.   Tfldname.DataSet := Main.DictTable;}
  151.   main.dicttable.Active:= True;
  152.   main.dicttable.fields[0].required := true;
  153.   main.dicttable.FieldDefs.UpDate;
  154.   main.dicttable.edit;
  155.   show;
  156. end;
  157.  
  158. procedure TDDedit.Table1FIELD_DECValidate(Sender: TField);
  159. begin
  160.   with DBRadioGroup1 do
  161.   if pos(DbRadioGroup1.values[itemindex], 'CLDM') <> 0
  162.     then editField_dec.text := '0';
  163. end;
  164.  
  165. Procedure TDDedit.table1Field_typeValidate(sender: TField);
  166. begin
  167.   if DBRAdioGroup1.itemindex = -1
  168.     then MessageDlg('Must select a data type', mtWarning, [mbOK], 0);
  169. end;
  170.  
  171. procedure TDDedit.Table1FIELD_LENValidate(Sender: TField);
  172. begin
  173.   case DBRAdioGroup1.values[Cur_data_type][1] of
  174.     'D' : EditField_len.text := '8';
  175.     'L' : EditField_len.text := '1';
  176.     'M' : EditField_len.text := '10';
  177.  
  178.   end;
  179. end;
  180.  
  181.  
  182. procedure TDDedit.EditFIELD_LENEnter(Sender: TObject);
  183. begin
  184.   if DBRadioGroup1.itemindex = -1
  185.     then begin
  186.       MessageDlg('Must specify a data type', mtWarning, [mbOK], 0);
  187.       DBradioGroup1.setfocus;
  188.       end
  189.     else begin
  190.       EditField_len.color := clYellow;
  191.       editField_len.readOnly := true;
  192.       editField_len.hint := 'Fixed length data type.';
  193.       case DBRAdioGroup1.values[DBRadioGroup1.itemindex][1] of
  194.          'C' : begin
  195.                  EditField_len.readOnly := false;
  196.                  EditField_len.hint := 'Max length is 254';
  197.                  end;
  198.          'D' : EditField_len.text := '8';
  199.          'L' : EditField_len.text := '1';
  200.          'M' : EditField_len.text := '10';
  201.          'N' : begin
  202.                  EditField_len.readOnly := false;
  203.                  EditField_len.hint := 'Max length is 20 (number of digits)';
  204.                  end;
  205.        end;
  206.      end;
  207. end;
  208.  
  209. procedure TDDedit.EditFIELD_DECEnter(Sender: TObject);
  210. begin
  211.   if DBRadioGroup1.itemindex = -1
  212.     then begin
  213.       MessageDlg('Must specify a data type', mtWarning, [mbOK], 0);
  214.       DBradioGroup1.setfocus;
  215.       exit;
  216.       end;
  217.   cur_data_type := dbRadioGroup1.itemIndex;
  218.   (sender as tdbedit).color := clYellow;
  219.   if pos(DbRadioGroup1.values[DBRadioGroup1.itemindex][1], 'CLDM') <> 0
  220.     then begin
  221.       editField_dec.text := '0';
  222.       editField_dec.ReadOnly := true;
  223.       editField_dec.hint := 'No Decimal length with this data type.';
  224.       editField_dec.showHint := true;
  225.       end
  226.     else begin
  227.       editField_dec.ReadOnly := false;
  228.       editField_dec.hint := 'Decimal length includes decimal; subtracts from length';
  229.       editField_dec.showHint := true;
  230.       end;
  231. end;
  232.  
  233.  
  234. procedure TDDedit.EnterEditFiel(Sender: TObject);
  235. begin
  236.   if sender is tdbedit
  237.     then (sender as tdbedit).color := clYellow;
  238.   if sender is tdbCheckBox
  239.     then (sender as tdbCheckBox).color := clYellow;
  240.   if sender is tdbMemo
  241.     then (sender as tdbMemo).color := clYellow;
  242.   if sender is tdbRadioGroup
  243.     then (sender as tdbRadioGroup).color := clYellow;
  244. end;
  245.  
  246. procedure TDDedit.ExitEditField(Sender: TObject);
  247. begin
  248.   if sender is tdbedit
  249.     then (sender as tdbedit).color := clWhite;
  250.   if sender is tdbCheckBox
  251.     then (sender as tdbCheckBox).color := clWhite;
  252.   if sender is tdbMemo
  253.     then (sender as tdbMemo).color := clWhite;
  254.   if sender is tdbRadioGroup
  255.     then (sender as tdbRadioGroup).color := clWhite;
  256. end;
  257.  
  258.  
  259. procedure TDDedit.Table1AfterOpen(DataSet: TDataset);
  260. begin
  261.   if DBRAdioGroup1.itemindex = -1
  262.     then DBRadioGroup1.itemIndex := 0;
  263. end;
  264.  
  265. procedure TDDedit.EditTABLE_NAMEExit(Sender: TObject);
  266. {linked to all required fields by object inspector}
  267. begin
  268.   if sender is tdbedit
  269.     then (sender as tdbedit).color := clLime;
  270.   if sender is tdbCheckBox
  271.     then (sender as tdbCheckBox).color := clLime;
  272.   if sender is tdbMemo
  273.     then (sender as tdbMemo).color := clLime;
  274.   if sender is tdbRadioGroup
  275.     then (sender as tdbRadioGroup).color := clLime;
  276.  
  277. end;
  278.  
  279. procedure TDDedit.FontButtonClick(Sender: TObject);
  280. begin
  281.   FontDialog1.Font := DDedit.Font;
  282.   if FontDialog1.Execute
  283.     then DDedit.Font := FontDialog1.Font;
  284. end;
  285.  
  286. procedure TDDedit.FormKeyDown(Sender: TObject; var Key: Word;
  287.   Shift: TShiftState);
  288. begin
  289.    if DataSource1.State in [dsEdit, dsInsert, dsBrowse]
  290.      then begin
  291.        if key = VK_NEXT
  292.           then DataSource1.dataset.next;
  293.        if key = VK_PRIOR
  294.           then DataSource1.dataset.prior;
  295. { AFter writing all this, it turns out clipboard automatically
  296.   supported .. adding this code just puts two copies of whatever's in the
  297.   clipboard into the element when you paste!
  298.       if sender is tdbmemo
  299.          then begin
  300.            if (Shift = [ssctrl]) and (key = ord('X'))
  301.               then (sender as tdbmemo).cutToClipboard;
  302.            if (Shift = [ssctrl]) and (key = ord('C'))
  303.               then (sender as tdbmemo).copyToClipboard;
  304.            if (Shift = [ssctrl]) and (key = ord('V'))
  305.               then (sender as tdbmemo).PasteFromClipboard;
  306.            end;
  307.        if sender is tdbedit
  308.          then begin
  309.            if (Shift = [ssctrl]) and (key = ord('X'))
  310.               then (sender as tdbedit).cutToClipboard;
  311.            if (Shift = [ssctrl]) and (key = ord('C'))
  312.               then (sender as tdbedit).copyToClipboard;
  313.            if (Shift = [ssctrl]) and (key = ord('V'))
  314.               then (sender as tdbedit).PasteFromClipboard;
  315.            end;}
  316.        end;
  317. end;
  318.  
  319. procedure TDDedit.CheckBox1Click(Sender: TObject);
  320. begin
  321.   if CheckBox1.checked
  322.     then begin
  323.       CheckBox1.caption := 'Hints on';
  324.       DdEdit.showHint := true;
  325.       end
  326.     else begin
  327.       CheckBox1.caption := 'Hints off';
  328.       DdEdit.showHint := false;
  329.       end;
  330. end;
  331.  
  332. procedure TDDedit.B_resizeClick(Sender: TObject);
  333. begin
  334.   ScalerForm.setWhichForm(DDedit);
  335.   if ScalerForm.showmodal = mrYes
  336.     then update;
  337. end;
  338.  
  339. { These two procedures work fine -- explode the memo to six
  340. lines when you enter it, and shrink it back when  you leave.
  341. Unfortunately, can't get it to come back to the same place
  342. in the case where the scrolling kicks in...}
  343. procedure TDDedit.MemoIDX_EXPRESEnter(Sender: TObject);
  344. begin
  345.   EnterEditFiel(sender);
  346.   fFormFiddle := false;
  347.   foldheight := (sender as tdbmemo).height;
  348.   foldtop := (sender as tdbmemo).top;
  349.   (sender as tdbmemo).height := (sender as tdbmemo).height * 6;
  350.    if ((sender as tdbmemo).top + (sender as tdbmemo).height) > (DDedit.top + DDedit.height)
  351.      then begin
  352.        fformfiddle := true;
  353.        (sender as tdbmemo).top :=
  354.          DDedit.top + (DDedit.height - (sender as tdbmemo).height - 6);
  355.        end;
  356.   (sender as tdbmemo).BringToFront;
  357. end;
  358. procedure TDDedit.MemoIDX_EXPRESExit(Sender: TObject);
  359. begin
  360.    if fFormFiddle
  361.      then scrollBox.scrollby(0,-(foldheight*6+10));
  362.   (sender as tdbmemo).height := foldheight;
  363.   (sender as tdbmemo).top := foldtop;
  364.   exitEditField(sender);
  365.   update;
  366. end;
  367.  
  368. procedure TDDedit.MemoDEFINEClick(Sender: TObject);
  369. begin
  370.   {Dangerous maneuver, typcasting like this; only doing it
  371.    because I've carefully set this one up to work for the tdbmemo
  372.    fields only.}
  373.   Edit_memo( tdbmemo(sender), EditTable_Name.text, EditField_name.text );
  374. end;
  375.  
  376. procedure TDDedit.DBNavigatorClick(Sender: TObject; Button: TNavigateBtn);
  377.   {something to make sure memo fields are scrolled to the top}
  378. var  i : integer;
  379. begin with DDedit as Tform do
  380.   for i := componentCount -1 downto 0 do
  381.     if components[i] is Tdbmemo
  382.       then (components[i] as tdbmemo).scrollby(0,-20);
  383. end;
  384.  
  385. end.
  386.